home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / cadence.zip / VOL2NO2.ZIP / GTCHANGE.LSP < prev    next >
Text File  |  1987-02-19  |  3KB  |  79 lines

  1. ; ================================================================
  2. ;   Listing 3: Global Text Editor            B. Kramer
  3. ;
  4. ;   Edit text generation characteristics in graphics editor.
  5. ;
  6. ;   CADENCE Tutorial Application #8
  7. ;
  8. ;   Variables:
  9. ;     S1     Selection set
  10. ;     User   User entry string
  11. ;     Elist  Entity list (from selection set accessing)
  12. ;     New    New variable data from user
  13. ;
  14. ; ================================================================
  15. (defun c:GTCHANGE ()
  16.    (setq S1 nil) (gc)   ; Clear Selection set for use.
  17.    (prompt "\nSelect text objects:")
  18.    (setq S1 (ssget))
  19.    (ss-sieve S1 "TEXT") ; Utility routine from Listing 2.
  20.    (setq User "Go")
  21.    (while (/= User "Exit")
  22.       (setq User
  23.         (strcase
  24.          (getstring "\nChange: Style/Height/Oblq angle/Rot angle/ <eXit>:")))
  25.       (if (> (strlen User) 1) (setq User (substr User 1 1)))
  26.       (cond
  27.         ((and (/= User "X") (/= User ""))
  28.           (setq Code
  29.              (cond
  30.                ((= User "S") 7) 
  31.                ((= User "H") 40)           
  32.                ((= User "O") 51)
  33.                ((= User "R") 50) 
  34.                (t nil)))
  35.           (cond
  36.              ((boundp 'Code)
  37.                (setq New (getstring "\nNew value:"))
  38.                (if (> Code 20) (setq New (atof New)))
  39.                (if (and (> Code 49) (< Code 60))
  40.                     (setq New (* (/ New 180.0) pi)))
  41.                (setq CNT -1)
  42.                (repeat (sslength S1)
  43.                   (setq Elist (entget (ssname S1 (setq CNT (1+ CNT)))))
  44.                   (entmod
  45.                     (cond
  46.                        ((null (assoc Code Elist)) 
  47.                           (append Elist (list (cons Code New))))
  48.                        (t
  49.                           (subst (cons Code New) (assoc Code Elist) Elist)
  50.                        )
  51.                     )
  52.                   )
  53.                 )
  54.              )
  55.              (t (prompt "\nEntry invalid:")))
  56.         )
  57.         (t
  58.            (setq User "Exit"))))) 
  59. ; ===============================================================
  60. ;
  61. ;   Removes entities from selection set that are not equal to the
  62. ;   entity type name passed as parameter two.
  63. ;
  64. ;   (ss-sieve S1 Screen)    Programming Utility Routine
  65. ;
  66. ;   Variables:
  67. ;      S1       Selection set
  68. ;      Screen   String of entity type to keep {eg: TEXT, LINE,...}
  69. ;      CNT      Index into selection set
  70. ;      Elist    Current entity list
  71. ; ===============================================================
  72. (defun ss-sieve (S1 Screen)
  73.    (setq CNT (sslength S1))
  74.    (while (> CNT 0)
  75.       (setq Elist (entget (ssname S1 (setq CNT (1- CNT)))))
  76.       (cond
  77.         ((/= (cdr (assoc 0 Elist)) Screen)
  78.           (ssdel (ssname S1 CNT) S1)))))
  79.